home *** CD-ROM | disk | FTP | other *** search
/ Aminet 24 / Aminet 24 (1998)(GTI - Schatztruhe)[!][Apr 1998].iso / Aminet / dev / lang / PPCsmalltalk.lha / PPCSmallTalk / examples / sim3.st < prev    next >
Text File  |  1986-10-19  |  4KB  |  150 lines
  1. "
  2.     Simple Minded simulation from Chapter 6 of book
  3.  
  4.     IceCream Store -
  5.         multiple event queue
  6. "
  7. Class Main
  8. [
  9.     main        | i |
  10.         i <- IceCreamStore new.
  11.         [i time < 60] whileTrue: [ i proceed ].
  12.         i reportProfits
  13. ]
  14.  
  15. Class Simulation
  16. | currentTime eventQueue |
  17. [
  18.     new
  19.         eventQueue <- Dictionary new.
  20.         currentTime <- 0
  21. |
  22.     time
  23.         ^ currentTime
  24. |
  25.     addEvent: event at: eventTime
  26.         (eventQueue includesKey: eventTime)
  27.             ifTrue: [(eventQueue at: eventTime) add: event]
  28.             ifFalse: [eventQueue at: eventTime
  29.                     put: (Set new ; add: event)]
  30. |    
  31.     addEvent: event next: timeIncrement
  32.         self addEvent: event at: currentTime + timeIncrement
  33. |
  34.     proceed        | minTime eventset event |
  35.         minTime <- 99999.
  36.         eventQueue keysDo:
  37.             [:x | (x < minTime) ifTrue: [minTime <- x]].
  38.         currentTime <- minTime.
  39.         eventset <- eventQueue at: minTime ifAbsent: [^nil].
  40.         event <- eventset first.
  41.         eventset remove: event.
  42.         (eventset isEmpty) ifTrue: [eventQueue removeKey: minTime].
  43.         self processEvent: event
  44. ]
  45.  
  46. Class IceCreamStore :Simulation
  47. | profit arrivalDistribution rand scoopDistribution remainingChairs |
  48. [
  49.     new
  50.         profit <- 0.
  51.         remainingChairs <- 15.
  52.         rand <- Random new.
  53.         (arrivalDistribution <- Normal new)
  54.             setMean: 3.0 deviation: 1.0.
  55.         (scoopDistribution <- DiscreteProbability new)
  56.             defineWeights: #(65 25 10).
  57.         self scheduleArrival
  58. |
  59.     scheduleArrival            | newcustomer time |
  60.         newcustomer <- Customer new.
  61.         time <- self time + (arrivalDistribution next).
  62.         (time < 15) ifTrue: [
  63.             self addEvent: [self customerArrival: newcustomer]
  64.                 at: time ]
  65. |
  66.     processEvent: event
  67.         ('event received at ', self time printString) print.
  68.         event value.
  69.         self scheduleArrival
  70. |
  71.     customerArrival: customer    | size |
  72.         size <- customer groupSize.
  73.         ('group of size ', size printString , ' arrives') print.
  74.         (size < remainingChairs)
  75.             ifTrue: [remainingChairs <- remainingChairs - size.
  76.                  'take chairs, schedule order' print.
  77.                  self addEvent: 
  78.                     [self customerOrder: customer]
  79.                     next: (rand randInteger: 3).
  80.                 ]
  81.             ifFalse: ['finds no chairs, leave' print]
  82. |
  83.     customerOrder: customer        | size numScoops |
  84.         size <- customer groupSize.
  85.         numScoops <- 0.
  86.         size timesRepeat: 
  87.             [numScoops <- numScoops + scoopDistribution next].
  88.         ('group of size ', size printString, ' orders ' ,
  89.         numScoops printString, ' scoops') print.
  90.         profit <- profit + (numScoops * 0.17).
  91.         self addEvent:
  92.             [self customerLeave: customer]
  93.             next: (rand randInteger: 5)
  94. |
  95.     customerLeave: customer        | size |
  96.         size <- customer groupSize.
  97.         ('group of size ', size printString, ' leaves') print.
  98.         remainingChairs <- remainingChairs + customer groupSize
  99. |
  100.     reportProfits
  101.         ('profits are ', profit printString) print
  102. ]
  103.  
  104. Class Customer
  105. | groupSize |
  106. [
  107.     new
  108.         groupSize <- (Random new "randomize") randInteger: 8
  109. |
  110.     groupSize
  111.         ^ groupSize
  112. ]
  113.  
  114. Class DiscreteProbability
  115. | weights rand max |
  116. [
  117.     defineWeights: anArray
  118.         weights <- anArray.
  119.         (rand <- Random new) "randomize".
  120.         max <- anArray inject: 0 into: [:x :y | x + y]
  121. |
  122.     next    | index value |
  123.         value <- rand randInteger: max.
  124.         index <- 1.
  125.         [value > (weights at: index)]
  126.             whileTrue: [value <- value - (weights at: index).
  127.                     index <- index + 1].
  128.         ^ index
  129. ]
  130.  
  131. Class Normal :Random
  132. | mean deviation |
  133. [
  134.     new
  135.         self setMean: 1.0 deviation: 0.5
  136. |
  137.     setMean: m deviation: s
  138.         mean <- m.
  139.         deviation <- s
  140. |
  141.     next        | v1 v2 s u |
  142.         s <- 1.
  143.         [s >= 1] whileTrue:
  144.             [v1 <- (2 * super next) - 1.
  145.              v2 <- (2 * super next) - 1.
  146.              s <- v1 squared + v2 squared ].
  147.         u <- (-2.0 * s ln / s) sqrt.
  148.         ^ mean + (deviation * v1 * u)
  149. ]
  150.